
type 'a maybe = Nothing | Value of 'a;;

type 'a listNode =
  {mutable next: 'a listNode maybe;
   mutable prev: 'a listNode maybe;
   mutable  value: 'a};;

type 'a dLList = {mutable first: 'a listNode; mutable last: 'a listNode};;

type 'a appNode = {mutable head: 'a; mutable body: 'a};;

type 'a appTree = Leaf of 'a | Branch of 'a appTree appNode;;

(*TODO: Eventually I want to support lists within the trees! For example:
type 'a lAppTree = LLeaf of 'a | LBranch of 'a lAppTree appNode | LList of 'a lAppTree dLList;;
*)

type atom = Byte of char | Combinator of int | Variable of int;;

(*These declarations not strictly needed:*)
  type expression = atom appTree;;
  type sequence = expression dLList;;
  (*The atom should, more specifically, be a Varible.*)
  type substitution = (atom * expression) list;;

let maybeCons head tail =
  match (head, tail) with
      (h, Nothing) -> Nothing
    | (h, Value t) -> Value (h :: t);;

let rec sortSubUnion sub1 sub2 =
  match (sub1, sub2) with
      ([], s2) -> Value s2
    | (s1, []) -> Value s1
    | ((Variable var1,val1) :: tail1, (Variable var2,val2) :: tail2) ->
        if var1>var2 then maybeCons (Variable var2,val2) (sortSubUnion sub1 tail2)
        else if var1<var2 then maybeCons (Variable var1,val1) (sortSubUnion tail1 sub2)
        else Nothing
    | _ -> raise (Invalid_argument "sortSubUnion");;

let rec subUnion sub1 sub2 =
  match (sub1, sub2) with
      (Value l1, Value l2) ->
        sortSubUnion (List.sort compare l1) (List.sort compare l2)
    | _ -> Nothing;;

(* treeMatchHere returns a Value which is a substitution if the tree "def" can be instantiated to match the tree "data". It returns Nothing if not. *)
let rec treeMatchHere def data =
  match (def, data) with
      (Leaf Variable a, b) -> Value [(Variable a, data)]
    | (a, b) when a=b -> Value []
    | (Branch {head=a; body=b}, Branch {head=c; body=d})
        -> subUnion (treeMatchHere a c) (treeMatchHere b d)
    | _ -> Nothing;;

(* matchHere TODO decide format and stuff! The dLL format does not seem like the best choice for def, and this bit does occur frequently, so should be optimised. *)
let rec matchHere def data =
  

(* The system will have some set of basic patterns, defined with just variable leafs, and it will count occurrences of instantiations of these as new elements of the data sequence come in and as modifications are made to it. High counts will lead to the creation of new combinators, and instances of the high-count patterns can then be transformed by reverse-application of those combinators. So, we need to keep track of:
-the small list of totally-variable patterns
-the list of partially-instantiated patterns and their counts
-which ones are already associated with combinators, and
-links to the instances of each partially instantiated pattern.*)

(* Ok: this makes trees with all the same var, to have vars imposed later. *)
let rec patternTreeGen size =
  if size = 1 then [Leaf (Variable 1)]
  else
    let resultList = ref [] in
      for i=1 to size-1 do
        (* put i nodes on left side, size-i on right; don't count self! *)
        (List.iter
          (fun f ->
            resultList := (List.map f (patternTreeGen (size-i))) @ !resultList)
          (List.map (fun a b -> Branch {head=a; body=b})
            (patternTreeGen i)))
      done;
    !resultList;;

let varListAll upTo =
  match upTo with
      n when n<1 -> []
    | n when n>0 -> (Variable n) :: varListAll (n-1);;

let varListAdd item someLists =
  List.map (fun l -> item :: l) someLists;;

let varListAddAll upTo someLists =
  List.concat (List.map (fun item -> varListAdd item someLists) (varListAll upTo));;

let rec varListMax varList =
  match varList with
      [] -> 0
    | Variable n :: l -> max n (varListMax l);;

let varListAddNext someLists =
  List.concat (List.map (fun l -> varListAddAll ((varListMax l)+1) [l]) someLists);;

let rec patternVarGen size =
  match size with
      0 -> []
    | 1 -> [[Variable 1]]
    | n -> varListAddNext (patternVarGen (size-1));;

let rec nthCdr l n =
  if List.length l = 0 then [] else if n = 0 then l else nthCdr (List.tl l) (n-1);;

let rec size tree =
  match tree with
      Branch {head = a; body = b} -> (size a) + (size b)
    | Leaf a -> 1;;

let rec assignValues tree values =
  match tree with
      Branch {head = a; body = b} -> 
        Branch {head = (assignValues a values); body = (assignValues b (nthCdr values (size a)))};
    | Leaf a -> Leaf (List.hd values);;

(*For now, I'll just generate patterns of one size. Patterns of multiple sizes might be more useful with sophisticated heuristics. Note: which patterns to look for is a fairly serious parameter to tweak. TODO this only handles tree patterns!!*)
let patternGen size = 
  let varPatterns = (patternVarGen size) in
    (List.flatten
      (List.map
        (fun tree -> List.map
          (fun varList -> assignValues tree varList)
          varPatterns)
        (patternTreeGen size) ) );;

(* Whew! So that generates the "small" list of totally-variable patterns to look for. Now we need to get serious: scanning input for these patterns, instantiating, storing, hashing, naming, reverse-executing... *)











